Map

---
knit: (function(input, ...) {
    rmarkdown::render(
      input,
      output_file = paste0(
        gsub(pattern = "NEY", replacement = paste0(format.Date(Sys.Date(),'%Y%m%d'),'_NEY'), x = xfun::sans_ext(input)),  '.html'
      ),
      envir = globalenv()
    )
  })
title: "NENC"
output: 
    flexdashboard::flex_dashboard:
        source_code: embed
    vertical-layout: scroll

---


```{r setup, include=FALSE}

#fillPage: true
#storyboard: false


library(flexdashboard)  ## dashboard

library(lubridate)      ## dates
library(tidyverse)      ## tidydata
library(glue)           ## text strings
library(readxl)         ## read excel docs
library(odbc)           ##database connections
library(DBI)            ##database connections

## Installing from GIThub
## May need a personal access token (PAT) - see 
## https://docs.github.com/en/enterprise-server@3.4/authentication/keeping-your-account-and-data-secure/creating-a-personal-access-token
## Then use Sys.setenv(GITHUB_PAT = 'xyz') where xyz is your token
##install.packages("remotes")
##Sys.setenv(GITHUB_PAT = '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')
##remotes::install_github("GIScience/openrouteservice-r")
##remotes::install_github("kent37/summarywidget")

library(openrouteservice) ##isochrome
library(rgdal)          ## read spatial data
library(sf)             ##spatial data

library(leaflet)        ## interactive maps
library(crosstalk)      ## map filters
library(htmltools)      ## html tools
library(DT)             ## Data tables
library(summarywidget)  ## crosstalk + text

library(scales)         ## pretty scales
library(fontawesome)    ## icons
library(viridis)        ## colour palette

## Custom function to format numbers, and suppress small numbers
supress <- function(x){ ifelse(between(x,1,5),'<6', comma(x,accuracy = 1)) }

# Foundry file
ExcelWorkbook <-
  "//ntpcts60.nntha.loc/shared_info/CSUs/NECS/Information Services/Analysis/Projects/DFIBS Map/Planning map/Defibs NENC.xlsx"
ExtractDate <- as_date("2023-12-14")

# Lookup
NEY_ICB <- c("NHS North East and North Cumbria Integrated Care Board"
             ,"NHS North East And North Cumbria Integrated Care Board"
             #,"NHS Humber and North Yorkshire Integrated Care Board"
             #,"NHS Humber And North Yorkshire Integrated Care Board"
             #,"NHS South Yorkshire Integrated Care Board"
             #,"NHS West Yorkshire Integrated Care Board"
             ,"North East and North Cumbria"
             #,"Humber and North Yorkshire"
             #,"South Yorkshire"
             #,"West Yorkshire"
             ,"CNE"
             ,"NENC"
             #,"HNY"
             #,"SY"
             #,"WY"
             )

```

```{r geoAPI, include=FALSE,eval=FALSE}

## Get data from GeoJSON ICB 2022 BUC
#data.Eng_ICB_2022_BUC <-
#  readOGR("https://services1.arcgis.com/ESMARspQHYMw9BZ9/arcgis/rest/services/Integrated_Care_Boards_July_2022_EN_BUC_v2/FeatureServer/0/query?outFields=*&where=1%3D1&f=geojson", verbose = FALSE)  %>%
#  st_as_sf() %>% 
#  mutate(NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE ) %>% as.factor())
#
## Save to project
#save(data.Eng_ICB_2022_BUC,file = glue("{getwd()}/Eng_ICB_2022_BUC"))
#
## Get data from GeoJSON MSOA 2011 BSC
#data.MSOA_2021_BSC <-
#  readOGR("https://services1.arcgis.com/ESMARspQHYMw9BZ9/arcgis/rest/services/Middle_Layer_Super_Output_Areas_DEC_2011_EW_BSC_V3/FeatureServer/0/query?where=1%3D1&outFields=OBJECTID,MSOA11CD,MSOA11NM,LONG,LAT&outSR=4326&f=json", verbose = FALSE)  %>%
#  st_as_sf()
#
## Save to project
#save(data.MSOA_2021_BSC,file = glue("{getwd()}/MSOA_2021_BSC"))

### Get data from GeoJSON LSOA 2011 IMD
#data.LSOA_2011_IMD <-
#  readOGR("https://services3.arcgis.com/ivmBBrHfQfDnDf8Q/arcgis/rest/services/Indices_of_Multiple_Deprivation_(IMD)_2019/Fea#tureServer/0/query?where=1%3D1&outFields=*&outSR=4326&f=json", verbose = FALSE)  %>%
#  st_as_sf()
#
### Save to project
#save(data.LSOA_2011_IMD,file = glue("{getwd()}/LSOA_2011_IMD"))


#
## Get data from GeoJSON CCG 2011 BSC
#data.CCG_2021_BSC <-
#  readOGR("https://services1.arcgis.com/ESMARspQHYMw9BZ9/arcgis/rest/services/CCG_APR_2021_EN_BSC_100M/FeatureServer/0/query?where=1%3D1&outFields=CCG21CD,CCG21NM,LONG,LA#T&outSR=4326&f=json", verbose = FALSE)  %>%
#  st_as_sf()
#
## Save to project
#save(data.CCG_2021_BSC,file = glue("{getwd()}/CCG_2021_BSC"))
```


```{r lookup, include = FALSE}

### connection function
#cn_fun <- function(){dbConnect(odbc()
#                               ,Driver = "SQL Server Native Client 11.0"
#                               ,Server = "PDC-SYS-SQL-107.systems.informatix.loc"
#                               ,database = "INFORMATIONTEAM"
#                               ,Trusted_Connection = "yes")}
#
#
### connects to the sql database
#cn <- cn_fun()
#
### MSOA names
#qry <- "SELECT * FROM [UK_Health_Dimensions].[MSOA_Names].[House_Of_Commons_Library_MSOA_Names_SCD] WHERE [Is_Latest] = 1;"
#data.msoa.names <- dbSendQuery(cn, qry) %>% dbFetch() %>%   select(MSOA11_Code,MSOA11_HCL_Name)
#
### disconnects from SQL
#dbDisconnect(cn)
#rm(cn)
#rm(qry)
#rm(cn_fun)

## ICBs
data.lsoa_to_icb.lu <- 
  read_csv('LSOA_to_ICB.csv') %>%
  select(LSOA11CD,ICB22NM) %>% 
  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE)
         ,ICB22NM = ICB22NM %>% str_remove("NHS ") %>% str_remove(" Integrated Care Board"))

### MSOA LU
#data.lsoa_to_msoa.raw <-
#  read_csv('MSOA_LU.csv')%>% 
#  select(-c(FID,OA11CD)) %>% 
#  filter(str_detect(LSOA11CD,'E.+')) %>% 
#  unique() 
#
### Combine
#data.lsoa_to_msoa.lu <-
#  data.lsoa_to_msoa.raw %>% 
#  left_join(data.lsoa_to_icb.lu, by = c('LSOA11CD' = 'LSOA11CD')) %>% 
#  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE)) %>% 
#  group_by(LSOA11CD,LSOA11NM,MSOA11CD,MSOA11NM,LAD20CD,LAD20NM,RGN20CD,RGN20NM) %>%
#  summarise(ICB22NM = first(ICB22NM, order_by = Flag_NEY)) %>% 
#  ungroup() %>% 
#  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE))

#data.msoa.lu <-
#  data.lsoa_to_msoa.lu %>% 
#  group_by(MSOA11CD,MSOA11NM,LAD20CD,LAD20NM,RGN20CD,RGN20NM) %>% 
#  summarise(ICB22NM = first(ICB22NM, order_by = Flag_NEY)) %>% 
#  ungroup() %>% 
#  mutate(Flag_NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE))


# Get data from GeoJSON LSOA_2011_IMD
attach(glue("{getwd()}/LSOA_2011_IMD"))
data.LSOA_2011_IMD <- data.LSOA_2011_IMD

## Smaller LSOA data set
data.LSOA_2011_IMD.NENC <-
  data.LSOA_2011_IMD %>% 
  left_join(data.lsoa_to_icb.lu, by = c('lsoa11cd' = 'LSOA11CD')) %>% 
  filter(Flag_NEY) 

## save
save(data.LSOA_2011_IMD.NENC,file = glue("{getwd()}/LSOA_2011_IMD_NENC"))

# Get data from GeoJSON CCG 2021 BSC
attach(glue("{getwd()}/CCG_2021_BSC"))
data.CCG_2021_BSC <- data.CCG_2021_BSC

data.ccg_to_icb.lu <- read_csv('CCG_to_ICB.csv') %>% 
  filter(`CCG Code` %in% c('00L','00N','00P','01H','13T','16C','84H','99C')) %>% 
  mutate(NENC = TRUE)

data.CCG_2021_BSC.NENC <-
  data.CCG_2021_BSC %>% 
  mutate(CCG21NM = str_to_upper(CCG21NM)) %>% 
  left_join(data.ccg_to_icb.lu, by = c("CCG21NM" = "CCG"))  %>% 
  filter(NENC == TRUE)


## save
save(data.CCG_2021_BSC.NENC,file = glue("{getwd()}/CCG_2021_BSC_NENC"))

rm(data.LSOA_2011_IMD)

```


```{r webdata, include=FALSE}

# Get data from ICS 2021 BFC
attach(glue("{getwd()}/Eng_ICB_2022_BUC"))
data.Eng_ICB_2022_BUC <- data.Eng_ICB_2022_BUC

data.Eng_ICB_2022_BUC <- data.Eng_ICB_2022_BUC %>% 
mutate(NEY = ifelse(ICB22NM %in% NEY_ICB,TRUE,FALSE ) %>% as.factor())

# Get data from GeoJSON MSOA 2021 BSC
attach(glue("{getwd()}/MSOA_2021_BSC_NEY"))
data.LSOA_2011_IMD.NENC <- data.LSOA_2011_IMD.NENC

# Get data from GeoJSON CCG 2021 BSC
attach(glue("{getwd()}/CCG_2021_BSC_NEY"))
data.CCG_2021_BSC.NEY <- data.CCG_2021_BSC.NEY

# Load Foundry data
#raw.data.population <- read_excel(ExcelWorkbook,sheet = "Population")

#data.population <-
#  raw.data.population 

# %>% select(-c(Row_Num)) %>% 
#  mutate(Spring_UptakePercent = Spring_Uptake / Spring_Pop)

#join
#data.MSOA_2021_BSC.NEY <-
#  data.MSOA_2021_BSC.NEY %>% 
#  left_join(data.population, by="MSOA11CD", suffix = c("",".y")) 

## Labels 
data.LSOA_2011_IMD.NENC <-
  data.LSOA_2011_IMD.NENC %>%
  mutate(label_imd = glue('
  

  
IMD Decile: {IMD_Decile}

  
{lsoa11nm}: {lsoa11cd}

  
LAD: {LADnm}

  
ICB: {ICB22NM}

  
IMD Rank: {IMD_Rank}

  
IMD Score: {IMDScore}

  
Total Population: {TotPop}

  
 ')) %>% 
  mutate(label_imd_rank = glue('
  

  
IMD Rank: {IMD_Rank}

  
{lsoa11nm}: {lsoa11cd}

  
LAD: {LADnm}

  
ICB: {ICB22NM}

  
IMD Decile: {IMD_Decile}

  
IMD Score: {IMDScore}

  
Total Population: {TotPop}

  
 '))


## Makes labels HTML
data.LSOA_2011_IMD.NENC$label_imd       <- lapply(data.LSOA_2011_IMD.NENC$label_imd,HTML)
data.LSOA_2011_IMD.NENC$label_imd_rank  <- lapply(data.LSOA_2011_IMD.NENC$label_imd_rank,HTML)



```

```{r localdata, include=FALSE}

# Get data for sites downloaded from Foundry
raw.data.Sites <-
  read_excel(ExcelWorkbook, sheet = "Defibs")

# Join Sites
data.Sites <-
  raw.data.Sites %>% 
  rename(Site_Name = location_name
         ,Site_ODS_code = unique_identifier
         ,LAD = ladnm
         ,Postcode = address_post_code
         ) %>% 
  ##filter(Site_Type != "LVS - Detained Estate") %>% 
  filter(!is.na(lat)) %>% 
  filter(lat != 0) %>% 
  mutate( 
  ICS = "CNE"
  ,Site_Type = defibrillators_availability
  ,Current_Status = defibrillators_access_type
  ,Site_Colour = Site_Type
  ,Site_Type = as_factor(Site_Type)
  #,CCG = str_remove_all(CCG,"NHS ") %>% str_remove_all(" CCG")
  ,across(.cols = c(lat,long), .fns = as.numeric)
  ,across(where(is.character), .fns = as.factor)  
  ) 


##Columns
data.Sites <-
  data.Sites %>%
  select(Site_Name
    ,Site_Type
    ,ICS
    #,CCG
    ,LAD
    ,Postcode
    ,Current_Status
    ,Site_Colour
    ,lat
    ,long
    )

## Labels
data.Sites <-
  data.Sites %>%
  mutate(label_text = glue(
'

{Site_Name}

Type: {Site_Type}

Status: {Current_Status}

LAD: {LAD}, Postcode: {Postcode}

'))

## Makes labels HTML
data.Sites$label_text <- lapply(data.Sites$label_text,HTML)

```

```{r functions, include=FALSE}


## Colours for markers
getColour <- function(Sites) {
  sapply(Sites$Site_Colour, function(Site_Colour) {
      case_when(Site_Colour == "24/7 Access"  ~ "green"
            ,Site_Colour == "Varied Access" ~ "orange" 
            ,TRUE ~ "black"  )  } )}

# glyphs for markers
getGlyph <- function(Sites) {
  sapply(Sites$Current_Status, function(Current_Status) {
  case_when( Current_Status == "Public" ~ "map"
            ,Current_Status == "Restricted" ~ "lock" 
            ,TRUE ~ "circle-xmark"  ) %>%
      fa(position = "middle",margin_right = 0) })}

# Makes icons
icons.sites <- awesomeIcons(text = getGlyph(data.Sites)
                            ,iconColor = 'white'
                            ,markerColor = getColour(data.Sites)
                            )

## Colours for polygons
PalDecile.colour <- inferno(10)[1:10]
PalRank.colour   <- mako(10)[1:10]

legend_labels_Decile <- c('1 (most deprived)'
                   ,'2'
                   ,'3'
                   ,'4'
                   ,'5'
                   ,'6'
                   ,'7'
                   ,'8'
                   ,'9'
                   ,'10 (least deprived)')

PalDecile <- colorBin( palette = c(PalDecile.colour)
                            , domain = legend_labels_Decile
                            , bins = c(1,2,3,4,5,6,7,8,9,10,Inf)
                            , na.color = '#F8F8F8FF')

legend_labelsRank <- c('1 - 3,199 (most deprived)'
                   ,'3,200 - 6,399'
                   ,'6,400 - 9,599'
                   ,'9,600 - 12,799'
                   ,'12,800 - 15,999'
                   ,'16,000 - 19,199'
                   ,'19,200 - 22,399'
                   ,'22,400 - 25,599'
                   ,'25,600 - 28,799'
                   ,'28,800 - 31,999'
                   ,'32,000 + (least deprived)')

PalRank <- colorBin( palette = c(PalRank.colour)
                            , domain = legend_labelsRank
                            , bins = c(0,3200,6400,9600,12800,16000,19200,22400,25600,28800,32000,Inf)
                            , na.color = '#F8F8F8FF')

## Colours for out of Area
OOA.colour <- '#808080E6'

PalOOA <- colorFactor(palette = c(OOA.colour,'#00000000')
                      , levels =  c(FALSE,TRUE)
                      , alpha = TRUE
                      , na.color = '#00000000')


```


```{r buildmap, include=FALSE}

share.data.Sites <- SharedData$new(data.Sites ,group="sites")
#share.data.Sites <- data.Sites

plot.map <-
  leaflet() %>% 
    setView(lat = 54.7, lng =  -2.0, zoom = 09) %>% 
  # ICS
    addPolygons(data = data.Eng_ICB_2022_BUC
              , fillColor = ~PalOOA(data.Eng_ICB_2022_BUC$NEY)
              , color = 'black', weight = 3, smoothFactor = 0.5) %>%
  # CCG
    addPolygons(data = data.CCG_2021_BSC.NEY
              , fillColor = "#FFFFFFFF"
              , color = 'black', weight = 3, smoothFactor = 0.5, dashArray = '4') %>%  
  # Chloropleth layers
  # IMD Decile
    addPolygons(data = data.LSOA_2011_IMD.NENC
              , group = "IMD Decile"
              , fillColor = ~PalDecile( data.LSOA_2011_IMD.NENC$IMD_Decile)
              , smoothFactor = 0.2, fillOpacity = 0.4
              , opacity = 1, color = ~PalDecile( data.LSOA_2011_IMD.NENC$IMD_Decile), weight = 0.5
              , highlightOptions = highlightOptions(color = "#444444", weight = 1,  bringToFront = TRUE)
              , label = data.LSOA_2011_IMD.NENC$label_imd ) %>% 
  # IMD Rank
      addPolygons(data = data.LSOA_2011_IMD.NENC
              , group = "IMD Rank"
              , fillColor = ~PalRank(data.LSOA_2011_IMD.NENC$IMD_Rank)
              , smoothFactor = 0.2, fillOpacity = 0.4
              , opacity = 1, color = ~PalRank( data.LSOA_2011_IMD.NENC$IMD_Rank), weight = 0.5
              , highlightOptions = highlightOptions(color = "#444444", weight = 1,  bringToFront = TRUE)
              , label = data.LSOA_2011_IMD.NENC$label_imd_rank ) %>% 
# Sites
  addAwesomeMarkers( data = share.data.Sites
                     , lat = ~lat, lng = ~long, icon = icons.sites, label = data.Sites$label_text) %>%
# Layer controls
  addProviderTiles(provider = providers$CartoDB.Positron) %>% 
  addLegend(data = data.LSOA_2011_IMD.NENC
           , position = "topright",labFormat = function(type, cuts, p){paste0(legend_labels_Decile)}
           , pal = PalDecile, values = ~ data.LSOA_2011_IMD.NENC$IMD_Decile
           , title = HTML("IMD Decile")) %>%  
  addLegend(data = data.LSOA_2011_IMD.NENC
           , position = "topright",labFormat = function(type, cuts, p){paste0(legend_labelsRank)}
           , pal = PalRank, values = ~ data.LSOA_2011_IMD.NENC$IMD_RANK
           , title = HTML("IMD Rank")) %>%  
  addLayersControl(baseGroups = c("IMD Decile","IMD Rank")
                   ,position = "bottomleft"
                   ,options = layersControlOptions(collapsed = FALSE) )
  
```


```{r build_datatable, include=FALSE}

#plot.table.sites <-
#  datatable(share.data.Sites
#            , rownames = FALSE
#            , extensions=c("Buttons","Scroller")
#            , style="bootstrap"
#            , class="compact"
#            , width="100%"
#   , options = list(deferRender=TRUE
#                 , scrollY="200px"
#                 , scroller=TRUE
#                 , dom = "Bfrtip"
#                 , searching = FALSE
#                 , buttons = c('copy', 'csv') 
#   , columnDefs = list( list(visible=FALSE, targets = c(seq(12,15) ) ) )  )
#      , colnames = c(
# "Name" ##0
#,"ODS Code"
#,"Type"
#,"ICB"
#,"CCG"
#,"LAD"
#,"Postcode"
#,"Current Status"
#,"Spring `23 VVE"
#,"Mean Week VVE"
#,"Median Week VVE"
#,"Max Week VVE"
#,"12"
#,"13"
#,"14"
#,"15"
#)) %>% 
#formatRound(columns = 9:12, digits = 0) 
# 
#
#
#
###Columns
#data.Sites <-
#  data.Sites %>%
#  select(Site_Name
#    ,Site_ODS_code
#    ,Site_Type
#    ,ICS
#    ,CCG
#    ,LAD
#    ,Postcode
#    ,Current_Status
#    ,Spring23_VVEs
#    ,Spring23_Mean_VVE_perWeek
#    ,Spring23_Median_VVE_perWeek
#    ,Spring23_Max_VVE_perWeek
#    ,Site_Colour
#    ,lat
#    ,long
#    ,label_text
#    )
```

Map
=====================================


Column {.sidebar}
-------------------------------------

### Filters

Total Sites: `r summarywidget(data = share.data.Sites, statistic = "count", digits = 0)`


#### Location
```{r map_filter_area}

#filter_select(id = "icb"
#                ,label = "ICB"
#                ,group = ~ICS
#                ,allLevels = FALSE
#                ,multiple = TRUE
#                ,sharedData = share.data.Sites)
#
#filter_select(id = "ccg"
#                ,label = "CCG"
#                ,group = ~CCG
#                ,allLevels = FALSE
#                ,multiple = TRUE
#                ,sharedData = share.data.Sites)

filter_select(id = "lad"
                ,label = "LAD"
                ,group = ~LAD
                ,allLevels = FALSE
                ,multiple = TRUE
                ,sharedData = share.data.Sites)
```

#### Type
```{r map_filter_type}

## status
filter_checkbox(id = "Current_Status"
             ,label = "Current Status"
             ,group = ~Current_Status
             ,inline = FALSE
             ,columns = 2
           ,sharedData = share.data.Sites)

## type
filter_checkbox(id = "type"
                ,label = "Site Type"
                ,group = ~Site_Type
                ,inline = FALSE
                ,sharedData = share.data.Sites)

```

Column
-------------------------------------

### `r glue("NENC DFIB Sites
Data updated: { format(ExtractDate,'%Y-%m-%d')}")`
```{r plot_map, fig.width=9, fig.height=4}

#Row {data-height=700}
#-------------------------------------

# plot
plot.map

```



```{r clean, include=FALSE, warning=FALSE}

# clean
gc()

# remove temp
rm(raw.data.population)
rm(raw.data.Sites)

```